C  SUBRS. ALPHA, RHORZ, SLUR,  LOOP, PLTSRT, LINES, RDRAW

C****** FOR LISTS OF LETTERS, ETC. *******
	SUBROUTINE ALPHA
	COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
	EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJE,RJQ(3))
	1,(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JI,JQ(7)),(JJ,JQ(8))
	1,(JK,JQ(9)),(JF,JQ(4)),(RJG,RJQ(5)),(RJD,RJQ(2))
	COMMON/STF/RSTFAC(8),RSTJC

	IF(JA.EQ.20)GO TO 20
	JA=5
54	R=19.7*RJE*RSTJC
	J=R
	RND=R-J
	R=0
	DO 50 KA=4,6
	JY=RJQ(KA)*100.+.2
	JX=1000000
	DO 53 LA=1,4
	JF=JY/JX
	IF(JF.NE.47.AND.JF.LT.90)CALL NOTWRT
C  47=BLANK  (WAS 99)
	JY=JY-JF*JX
	JB=JB+J
	R=R+RND
	IF(R.LT.1.0)GO TO 53
	JB=JB+1
	R=R-1.0
53	JX=JX/100
50	CONTINUE
	RETURN
C  FOR TRILLS
20	R=RJB
C  R SAVES RJB(WHICH GETS CLOBBERED WHEN 'TR' IS WRITTEN.)
C 20, POS1, STF, NT#, 0, POS2, X     IF X=1 THEN NO WAVEY LINE
	RJE=.65
	JE=0
	JA=5
	JF=29
C   DRAWS T
	CALL NOTWRT
	JF=27
C   DRAWS R
	JB=JB+11*RSTJC
51	CALL NOTWRT
	IF(JG.NE.0)RETURN
	JB=JB+16*RSTJC
C   RETURN IF NO WAVY LINE IS NEEDED
	JA=4
	RJB=R+4.*RSTJC
	JG=-2
C  JG IS SWITCH TO DRAW WIGGLE
	RJE=RJD+.8
	CALL ITMSUB
	END

	FUNCTION RHORZ(R)
	RHORZ=R*5.96-596.
	END


	SUBROUTINE SLUR
	IMPLICIT INTEGER(A-Q,T-Z)
	REAL CENTR,PWDS
	COMMON /XRN/RN(4000) /PLTR/PLT,RHT,DIS
	COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
	COMMON/PTR/PWDS(250),ITEM,L,I,IX /STF/RSTFAC(8),RSTJC
	EQUIVALENCE (RJG,RJQ(5)),(RJF,RJQ(4)),(JG,JQ(5)),
	1(JH,JQ(6)),(JI,JQ(7)),(JJ,JQ(8))
	1,(JF,JQ(4)),(RJD,RJQ(2)),(RJE,RJQ(3)),(RF,RJQ(20))
	DIMENSION SLURX(53),SLURY(53),RSEQ(26)
      DATA RSEQ/70.0,64.0,59.0,53.9,49.0,44.1,40.0,35.8,32.0,28.2,
	1 25.0,21.8,19.0,16.3,14.0,11.9,10.0,8.4,6.8,5.3
	1 ,4.0,2.9,2.0,1.4,1.0,.07/
	IF(JA.NE.12)GO TO 2
	RA=5.96*RSTJC*RJE
	L=3
	IF(JG.LE.JF)JG=JG+360
	JH=6
	IF(PLT)JH=1
	DO 3 K=JF,JG,JH
	R=K
	CALL LINES(RJB+RA*SIND(R),CENTR+RA*COSD(R),L)
3	L=2
C  JA=12  DRAWS CIRCLES.  P5=RADIUS, P6=DEGR.1, P7=DEGR.2
	RETURN
2	JJ=1
21	TWICE=0
22	RST7=RSTJC*7.
	GO TO (5,6,7),JH+4
	GO TO 4
5	R=32
C AFTER DOTTED NOTE
	GO TO 8
6	R=22
C BETWEEN NOTES
8	RX=-1.3
	GO TO 9
7	R=7
	RX=RSTJC
9	RJB=RJB+R*RSTJC
	RJF=RJF+RX
4	RXX=RHORZ(RJF)-RJB
	RTILT=(RJE-RJD)*RST7
80	RX=SQRT(RXX**2+RTILT**2)
1	R=CENTR
	IF(JH.GT.0)GO TO 180
C  FOR BRACKETS
	RB=RX/52.
	DO 81 K=1,53
81	SLURX(K)=RB*(K-1)+RJB
	RA=-RJG*RST7
	R=R-RA
	RW=630.
	RB=RA/RW
	DO 82 K=1,26
	SLURY(K)=RW*RB+R
	SLURY(54-K)=SLURY(K)
82	RW=RW-RSEQ(K)
	SLURY(27)=SLURY(26)
	L=53

89	IF(RTILT.EQ.0)GO TO 87
	RW=ATAN2(RTILT,RXX)
	RA=SIN(RW)
	RB=COS(RW)
	RZ=SLURX(1)
	RW=SLURY(1)
	DO 84 K=1,L
	SLURX(K)=SLURX(K)-RZ
84	SLURY(K)=SLURY(K)-RW
	DO 83 K=1,L
	R=SLURX(K)
	SLURX(K)=RB*R-RA*SLURY(K)+RZ
83	SLURY(K)=RB*SLURY(K)+RA*R+RW

87	CALL LINES(SLURX(JJ),SLURY(JJ),3)
	DO 88 K=JJ+1,L
88	CALL LINES(SLURX(K),SLURY(K),2)
	IF(TWICE)RETURN
	TWICE=-1
	RJG=RJG+.1
	GO TO 1
	RETURN
180	RW=R+RJG*RST7
	RX=RX+RJB
	RA=(RJE-RJD)*RST7
	SLURX(1)=RJB
	SLURY(1)=R
	SLURX(2)=RJB
	SLURY(2)=RW
	SLURX(3)=RX
	SLURY(3)=RW+RA
	SLURX(4)=RX
	SLURY(4)=R+RA
	L=4
	IF(JH.EQ.2)L=3
	IF(JH.EQ.3)JJ=2
	TWICE=-1
	GO TO 87
	END
C  8, POS1, STF, NT1, NT2, POS2, DIP(ABS. UNITS), P8
C        FOR P8: 0= SLUR, 1=BRACKETS, 2=LFT ONLY, 3=RT ONLY


	SUBROUTINE LOOP(I,J,K,L,M,N)
	DIMENSION N(1)
	DO 1 NN=I,J,K
1	N(NN+L)=N(NN+M)
	END


	SUBROUTINE PLTSRT
C  SORTS DATA TO SHORTEN INVISIBLE VECTORS WHEN PLOTTING. 
	IMPLICIT INTEGER(S-Z)
	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
	DIMENSION  P(250)
	DO 4 K=1,ITEM
	L=PWDS(K)
	A=RN(L+2)
 	P(K)=A+1000*RN(L+3)
4	IF(A.LT.0)P(K)=-10000
C  PLOTS ALL NEG. POSITIONS FIRST.
	Y=I
2	A=P(1)
	L=1
	DO 1 K=1,ITEM
	IF(A.LE.P(K))GO TO 1
	A=P(K)
	L=K
1	CONTINUE
	IF(A.EQ.10000.)RETURN
C  ALL ITEMS HAVE NOW BEEN SHUFFLED
	V=PWDS(L)
	P(L)=10000
	L=RN(V)+2
	CALL LOOP(0,L,1,Y,V,RN)
	Y=Y+L+1
	GO TO 2
	END


	SUBROUTINE LINES(A,B,L)
	COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
	COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
	COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
	COMMON/DPY/IGO,RXGP,ITOP,IBOT
	DATA BB/260.0/,CC/3.5/,DD/1.43/,MX/512/,XGP/1200.0/
C  SET XGP TO 1245.0 FOR MARGIN IN XEROX COPIES
22	GO TO 23
C  CHANGE ABOVE TO 'JFCL' IN DDT TO USE NEXT ITEMS.
24	AA=CC-DD*ABS(A)/BB
C  USE THIS IN DDT TO DISTORT ITEMS.  CC MUST BE > DD
	B=B*AA
23	IF(IPLT)GO TO 2
	M=A*RSZ
	N=B*RSZ
3	IF(JA.EQ.44)GO TO 6
	K=B
	IF(K.GT.ITOP)ITOP=B
	IF(K.LT.IBOT)IBOT=B
6	RETURN
2	IF(IPLT.EQ.-2)RETURN
C RXGP SETS UP-DOWN POS. ON XEROX PAPER (FRACTIONAL POSITIONS POSSIBLE.)
	IF(IXRX.EQ.0)GO TO 9
	M=ROFF(RXGP-B*RHT)
	N=ROFF(XGP+A*DIS)
	GO TO 8
9	M=ROFF(A*DIS)
	N=ROFF(B*RHT)
8	CALL PLOT(M,N,L)
	END

	SUBROUTINE RDRAW(I,S,XY,X,RJB,CENTR,RMINI)
C   TO X,Y INTO ONE WORD
	DIMENSION XY(1)
	DO 2 K=I,IFIX(S)
	L=2
	Y=XY(K)
	IF(Y.LT.1000.)GO TO 3
	L=3
	Y=Y-1000.
C   >1000 = INVIS. LINE
3	M=Y
	Y=(Y-M)*1000.
	IF(Y.GT.100.)Y=100-Y
C   Y NUMBERS .GT.100 ARE NEG.
	B=Y*X+CENTR
	IF(M.GT.60)M=100-M
	A=M*RMINI+RJB
2	CALL LINES(A,B,L)
	END

	FUNCTION IABS(N)
	IABS=N
	IF(N)IABS=-N
	END

	BLOCK DATA
	IMPLICIT INTEGER(A-Q,S-Z)
	COMMON /NW/FILL(7),RNOTE(24)
	COMMON /NU/NUMQ(44),RNUMS(327),RACCI(32),NACCI(3)
	DATA FILL/4,5,6,6,6,5,4/,
     1 RNOTE/ 1000., .002, 2.005, 6.007, 10.007, 14.005, 16.002,
     1 16.102, 14.105, 10.107, 6.107, 2.105, .102, 0, 4.005, 11.006,
     1 1016., 12.105, 5.106, 1000.,7.007,14., 7.107, 0/,
     1 NUMQ/1,11,15,23,33,38,47,57,62,79, 89,95,108,117,125,132,138
     1,150,157,164,171,177,181,187,1,192,200,212,221,234,239,246
     1,250,256,261,266,  271,282,285,293,298,307,316,321/
      DATA (RNUMS(K),K=1,131)/10.0,1003.107, 6.102, 6.01, 3.015,
     1 104.015, 107.01,107.102, 104.107, 3.107,
     1 14.0, 1103.011, 1.015, 1.107, 22.0,
     1 1106.011, 102.015, 3.015, 7.011, 7.005, 107.107, 7.107, 32.0,
     1 1107.015, 7.015, 101.007, 3.007, 7.003, 7.102, 3.107, 103.107,
     1 107.103, 37.0, 1007.102, 107.102, 2.015, 2.107, 46.0, 1107.107,
     1 4.103, 7.0, 7.004, 2.006, 107.004, 107.015, 7.015, 56.0,
     1 1004.015, 107.0, 107.103, 103.107, 4.107, 7.103, 7.0, 3.003,
     1 104.003, 61.0, 1107.011, 107.015, 7.015, 107.107, 78.0, 1003.004,
     1 7.0, 7.103, 4.107, 104.107, 107.103, 107.0, 103.004, 3.004,
     1 6.008, 6.012, 2.015, 102.015, 106.012, 106.008, 103.004,
     1 88.0, 1104.107, 7.008, 7.011, 4.015, 104.015, 107.011, 107.008,
     1 103.005, 4.005, 94.0, 1106.107, 0.015,6.107,1004.101,104.101,
     1 107.0, 1106.107, 106.015, 3.015, 6.012, 6.007, 3.004, 1106.004,
     1 2.004, 6.001, 6.104, 3.107, 106.107, 116.0, 1006.104, 3.107,
     1 103.107, 106.104, 106.011, 103.015, 3.015, 6.011, 124.0,
     1 1106.107, 106.015, 3.015, 6.011, 6.103, 3.107, 106.107,
     1 131.0, 1006.107, 106.107, 106.015, 6.015, 1003.005, 106.005/
C   THE NEXT IS FOR 'F' TO 'P'
C   1 NUM NOT NEEDED IN 'G'  ALSO IN RNOTE (1/2 NOTE).
      DATA (RNUMS(K),K=132,199)/
     1 137.0, 1106.107, 106.015, 6.015, 1003.005, 106.005, 149.0, 
     1 1001.102, 6.102, 6.104, 6.104, 3.107, 103.107, 106.104, 
     1 106.011, 103.015, 3.015, 6.011, 156.0, 1106.107, 106.015,
     1 1006.015, 6.107, 1006.005, 106.005, 163.0, 1103.107,3.107,
     1 1000.107, 0.015, 1103.015, 3.015,
     1 170.0, 1106.102, 106.104, 103.107, 3.107, 6.104, 6.015, 
     1 176.0, 1106.107, 106.015, 1006.015, 106.005, 6.107, 180.0,
     1 1006.107, 106.107, 106.015, 186.0, 1106.107, 106.015, 0.004,
     1 6.015, 6.107, 191.0, 1106.107, 106.015, 6.107, 6.015, 199.0
     1, 1106.107, 106.015, 3.015, 6.012, 6.007, 3.004, 106.004/ 
C   'Q' TO ')'
      DATA(RNUMS(K),K=200,327)/
     1 211.0, 1003.107, 6.102, 6.01, 3.015, 103.015, 106.01, 106.102,
     1 103.107, 3.107, 1001.001, 7.108, 220.0, 1106.107, 106.015,
     1 3.015, 6.012, 6.007, 3.004, 106.004, 6.107, 233.0, 1106.104,
     1 103.107, 3.107, 6.104, 6.001, 3.004, 103.004, 106.007, 106.011,
     1 103.015, 3.015, 6.01, 238.0, 1106.015, 7.015, 1000.015, 0.107,
     1 245.0, 1106.015, 106.104, 103.107, 3.107, 6.104, 6.015, 249.0,
     1 1106.015, 0.107, 6.015, 255.0, 1106.015, 104.107, 0.005, 4.107,
     1 6.015, 260.0, 1106.015, 6.107, 1106.107, 6.015, 265.0, 1106.015,
     1 0.003, 1106.107, 6.015, 270.0, 1106.015, 6.015, 106.107, 6.107,
     1 281.0, 1101.102, 101.105, 1.105, .102, .105, 101.102, 1.102,
     1 1.108, 102.112, 1102.112, 284., 1106.004, 6.004, 292., 1101.102,
     1 101.105, 0.102, 0.105, 1.102, 1.105, 101.102, 297.0, 1106.008,
     1 6.008, 1106.001, 6.001, 306.0, 1003.015, 0.013, 102.009,
     1 103.007, 103.0, 102.101, 0.105, 3.107, 315.0, 1103.015, 0.013,
     1 2.009, 3.007, 3.0, 2.101, 0.105, 103.107, 320.0, 1106.004,
     1 6.004, 1000.01, 0.102,  327.0,1106.004, 6.004, 1003.009,
     1 103.101, 1003.101, 103.009/

C  1-10=NUMS 0-9, 11-36=ALPHA, 37-42=SIGNS
	DATA RACCI/8.0,1114.003,111.007, 108.007, 106.003, 107.101
     1,114.108, 114.02, 21.0,1104.105, 118.109, 118.108,104.104
     1,1108.113, 108.016,  1104.008, 118.004, 118.005,104.009
     1,1114.014, 114.115, 32.0,1106.117, 106.007, 114.004
     1,114.004, 106.007, 1114.018, 114.107, 106.104, 106.103
     1,114.106/,NACCI/1,9,22/
	END

C   *******  7, POS,  STF, NUM OF SHARPS OR FLATS (+ OR -), CLEF, HGT
C		      (	CLEF = TREB,0  BASS,1  ALT,2  TEN,3 )
	SUBROUTINE KSIG
C   FOR KEY SIGNATURES AND ACCENTS, ETC. (IN 'SCORE')
	COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/STF/RSTFAC(8),RSTJC
	EQUIVALENCE (RJD,RJQ(2)),(JD,JQ(2)),(JE,JQ(3)),(JF,JQ(4))

	JA=6
C  USES THIS KEY NUM IN NOTWRT
	KN=0
C   COUNTER
	IZ=IABS(JD)
C  NUMBER OF CALLS ON NOTWRT
C  THE CLEF NUM.  IT GETS WIPED OUT IN NOTWRT.
	JW=1
	IF(JD.GT.0)JW=2
C   THE CODE FOR FLAT OR SHARP
5333	CLEF=-(JE+1)
C CLEF #S ARE CHNGD TO -1,-2,-3,-4 (TREB.,BA.,ALT.,TEN.)
C  CLEF NOW SET IN MAIN PROG.
C  IF NO CLEF GIVEN, TREBLE IS USED.
	T=10.
	IF(CLEF.LT.-2.)T=11.
	S=CLEF+4.
	IF(CLEF.EQ.-4)S=-1.
	IF(JD.LT.0)GO TO 253
	W=-3.
	YY=4.
	Z=11.
C  SHARPS
	GO TO 353
253	W=3.
	YY=-4.
	Z=7.
C  FLATS
353	N=1
	RX=JB
	RA=0
C   RA IS AMOUNT TO BE ADDED TO ORIGINAL POS.
	DO 553 KA=1,IZ
	JE=JW
	JB=RX+RA
	RA=RA+13.*RSTJC
C  MOVES OVER FOR NEXT ACCI.
	RD=Z
	RJD=Z
	IF(CLEF.NE.-1.)GO TO 7
	IF(RJD.GT.12.)RJD=RJD-7.
	GO TO 9
7	RJD=RJD-S
	IF(RJD.GT.T)RJD=RJD-7.
C  ABOVE ARRANGES VERT. POS OF ACCIS.
9	JD=RJD
	CALL NOTWRT
	Z=RD+W
	IF(N)Z=RD+YY
553	N=-N
	END
	SUBROUTINE NOIR(RMINI)
C  BLACKS IN NOTES
	COMMON/DL/IXRX,Q,AA
	COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
	COMMON/PLTR/IPLT,RHT,DIS
	COMMON/DPY/IGO,RXGP,ITOP,IBOT
	EQUIVALENCE (JF,JQ(4))
	DATA IXGP/1200/,BL/7.4/,BH/6.5/,CX/1.0/,FL/0.0/
C  ADJUST BH AND FL FOR HEIGHT OF NOTE AND 'WIDTH'
	JXG=RXGP
	B=CENTR*RHT
	C=CX
	IF(B)C=-C
	KC=B+C
	D=RJB*DIS
	B=BH*RMINI*RHT
	A=BL*RMINI*DIS
	BX=.5
	IF(D)BX=-BX
	C=A+D+BX
C ROUND-OFF MAY GIVE SMALL ERROR WHEN X COORD.=NEAR 0.
	A=A*A
	K=B+FL
	B=B*B
C  USES EQUATION FOR ELLIPSE
	N=1
5	L=C
	JY=KC
	IF(IXRX.EQ.0)GO TO 4
	JY=IXGP+L
	L=JXG-KC
4	CALL PLOT(L,JY,3)
6	DO 1 J=-K,K
	Y=J*J
	JY=J+KC
	X=SQRT(A-(A*Y)/B)
	L=C-X
	M=C+X
C  THE TWO SIDES OF THE LINE
	JZ=JY
	IF(N)CALL EXCH(L,M)
	IF(IXRX.EQ.0)GO TO 3
	I=L
	L=JXG-JY
	JY=IXGP+I
	JZ=M
	M=L
	JZ=IXGP+JZ
3	CALL PLOT(L,JY,2)
	CALL PLOT(M,JZ,2)
1	N=-N
	END